home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0147_Heap Management Tools.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  2.5 KB  |  109 lines
  1. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2.            ╔═══════════════════════════════════════════════╗
  3.            ║ Heap management procedures, by Keld R. Hansen ║
  4.            ║       From SWAG, in the "EXEC" section.       ║
  5.            ╚═══════════════════════════════════════════════╝
  6.  
  7. EXECUTE shrinks your program's memory allocation to the smallest possible
  8. value, runs the specified program, and then expands the memory allocation
  9. again.  Tested with Turbo Pascal 6.0 and 7.0, and Borland Pascal 7.0.
  10.  
  11. Usage: Put HeapMan in your USES clause, and call Execute instead of Exec.
  12.  
  13. Notice: Do NOT SwapVectors, since HeapMan.Execute does it for you.
  14.  
  15. WARNING: DOS.DosExitCode will no longer be valid.
  16. Instead, query Heapman.DosExitCode after calling HeapMan.Execute.
  17. ________________________________________________________________________*)
  18.  
  19. {$N-,E- no math support needed}
  20. {$X- function calls may not be discarded}
  21. {$I- disable I/O checking (trap errors by checking IOResult)}
  22. {$S- no stack checking code [routine will fail without this directive!]}
  23.  
  24. Unit HeapMan;
  25.  
  26. Interface
  27.  
  28. USES
  29.   DOS;
  30.  
  31. VAR
  32.   DosExitCode: WORD;
  33.  
  34. PROCEDURE SetHeapManDosExitCode;
  35. PROCEDURE ReallocateMemory(P : POINTER);
  36. FUNCTION EXECUTE(Name : PathStr ; Tail : STRING) : WORD;
  37.  
  38. Implementation
  39.  
  40. PROCEDURE SetHeapManDosExitCode;
  41. BEGIN
  42.   HeapMan.DosExitCode := DOS.DosExitCode;
  43. END;
  44.  
  45. PROCEDURE ReSetHeapManDosExitCode;
  46. BEGIN
  47.   HeapMan.DosExitCode := 0;
  48. END;
  49.  
  50. PROCEDURE ReallocateMemory(P : POINTER); ASSEMBLER;
  51. ASM
  52.   MOV  AX, PrefixSeg
  53.   MOV  ES, AX
  54.   MOV  BX, WORD PTR P+2
  55.   CMP  WORD PTR P,0
  56.   JE   @OK
  57.   INC  BX
  58.  
  59.  @OK:
  60.   SUB  BX, AX
  61.   MOV  AH, 4Ah
  62.   INT  21h
  63.   JC   @X
  64.   LES  DI, P
  65.   MOV  WORD PTR HeapEnd,DI
  66.   MOV  WORD PTR HeapEnd+2,ES
  67.  
  68.  @X:
  69. END;
  70.  
  71. FUNCTION EXECUTE(Name : PathStr ; Tail : STRING) : WORD; ASSEMBLER;
  72. ASM
  73. {$IFDEF CPU386}
  74.   DB      66h
  75.   PUSH    WORD PTR HeapEnd
  76.   DB      66h
  77.   PUSH    WORD PTR Name
  78.   DB      66h
  79.   PUSH    WORD PTR Tail
  80.   DB      66h
  81.   PUSH    WORD PTR HeapPtr
  82. {$ELSE}
  83.   PUSH    WORD PTR HeapEnd+2
  84.   PUSH    WORD PTR HeapEnd
  85.   PUSH    WORD PTR Name+2
  86.   PUSH    WORD PTR Name
  87.   PUSH    WORD PTR Tail+2
  88.   PUSH    WORD PTR Tail
  89.   PUSH    WORD PTR HeapPtr+2
  90.   PUSH    WORD PTR HeapPtr
  91. {$ENDIF}
  92.   CALL ResetHeapManDosExitCode;
  93.   CALL ReallocateMemory
  94.   CALL SwapVectors
  95.   CALL DOS.EXEC
  96.   CALL SwapVectors
  97.   CALL ReallocateMemory
  98.   CALL SetHeapManDosExitCode
  99.   MOV  AX, DosError
  100.   OR   AX, AX
  101.   JNZ  @OUT
  102.   MOV  AH, 4Dh
  103.   INT  21h
  104.  
  105.  @OUT:
  106. END;
  107.  
  108. END.
  109.